home *** CD-ROM | disk | FTP | other *** search
/ Aminet 23 / Aminet 23 (1998)(GTI - Schatztruhe)[!][Feb 1998].iso / Aminet / misc / emu / DCMtoImg.lha / cvtDCM.p < prev    next >
Text File  |  1996-10-16  |  9KB  |  270 lines
  1. program cvtDCM;
  2.  
  3. var multiExpected, notOpen, misMatch, done, err,
  4.     hasAddr, newStart, use: Boolean;
  5.     ch, letter: char;
  6.     header, code, densityCode, lo, hi, data, start, limit, fill: byte;
  7.     size, offs, numSecs, secNo, newSec, regX, i: integer;
  8.     count: longint;
  9.     a: file of byte;
  10.     b: file;
  11.     ATRheader: array[0..15] of byte;
  12.     fileName, inPathName, outPathName: string[64];
  13.     buffer, pad: array[0..127] of byte;
  14.  
  15. begin
  16.   for i := 0 to 127
  17.     do pad[i] := 0;
  18.   if ParamCount = 0
  19.       then begin
  20.         write('File name? ');
  21.         readln(fileName)
  22.       end
  23.     else fileName := ParamStr(1);
  24.   if pos('.', fileName) <> 0
  25.       then begin
  26.         writeln('''.'' not valid in file name!');
  27.         halt(20)
  28.       end;
  29.   outPathName := fileName;
  30.   size := length(fileName);
  31.   if pos('/', fileName) <> 0
  32.       then begin
  33.         i := size;
  34.         repeat
  35.           ch := fileName[i];
  36.           if ch <> '/'
  37.               then i := i - 1
  38.         until ch = '/';
  39.         outPathName := copy(filename, i + 1, size - i)
  40.       end;
  41.   multiExpected := false;
  42.   if size > 2
  43.       then if (UpCase(fileName[size - 1]) = 'F') and (fileName[size] = '1')
  44.                then begin
  45.                  outPathName := copy(outPathName, 1, length(outPathName) - 2);
  46.                  offs := size;
  47.                  multiExpected := true
  48.                end;
  49.   inPathName := fileName + '.dcm';
  50.   secNo := 1;
  51.   numSecs := 720;
  52.   notOpen := true;
  53.   done := false;
  54.   repeat
  55.     assign(a, inPathName);
  56.     reset(a);
  57.     if eof(a)
  58.         then begin
  59.           if not multiExpected
  60.               then begin
  61.                 writeln('File missing!');
  62.                 err := true
  63.               end
  64.             else done := true
  65.         end
  66.       else begin
  67.         read(a, header);
  68.         count := 1;
  69.         misMatch := (multiExpected and (header = $FA))
  70.                     or (not multiExpected and (header = $F9));
  71.         if misMatch
  72.             then begin
  73.               writeln('Input file header error!');
  74.               close(a);
  75.               halt(20)
  76.             end;
  77.         read(a, code);
  78.         count := count + 1;
  79.         densityCode := (code and $60) shr 5 + 1;
  80. {
  81.         writeln('Density code is ', densityCode);
  82. }
  83.         if (densityCode < 1) or (densityCode > 3)
  84.             then begin
  85.               writeln('Invalid density code!');
  86.               close(a);
  87.               if not notOpen
  88.                   then close(b);
  89.               halt(20)
  90.             end;
  91.         if densityCode = 2
  92.             then begin
  93.               writeln('Can''t do double density yet!');
  94.               close(a);
  95.               if not notOpen
  96.                   then close(b);
  97.               halt(20)
  98.             end;
  99.         read(a, lo, hi);
  100.         count := count + 2;
  101.         newSec := hi * 256 + lo;
  102.         if secNo <> newSec
  103.             then begin
  104.               writeln('Input file header error!');
  105.               close(a);
  106.               if not notOpen
  107.                   then close(b);
  108.               halt(20)
  109.             end
  110.         err := false;
  111.         if notOpen
  112.             then begin
  113.               if densityCode = 3
  114.                   then outPathName := outPathName + '.ATR'
  115.                 else outPathName := outPathName + '.XFD';
  116.               assign(b, outPathName);
  117.               rewrite(b, 16);
  118.               if densityCode = 3
  119.                   then begin
  120.                     ATRheader[0] := $96;
  121.                     ATRheader[1] := $02;
  122.                     ATRheader[2] := 1040 mod 256;
  123.                     ATRheader[3] := 1040 div 256;
  124.                     ATRheader[4] := 128;
  125.                     ATRheader[5] := 0;
  126.                     for i := 6 to 15
  127.                       do ATRheader[i] := 0;
  128.                     BlockWrite(b, ATRheader, 1);
  129.                     numsecs := 1040
  130.                   end;
  131.               notOpen := false
  132.             end;
  133.         repeat
  134.           read(a, code);
  135.           count := count + 1;
  136.           hasAddr := (code and $80) = 0;
  137.           letter := chr(code and $7F);
  138. {
  139.           writeln('Code is ''', letter, '''');
  140. }
  141.           case letter of
  142.               'A': begin
  143.                      read(a, start);
  144.                      count := count + 1;
  145.                      regX := start;
  146.                      repeat
  147.                        read(a, data);
  148.                        count := count + 1;
  149.                        buffer[regX] := data;
  150.                        regX := regX - 1
  151.                      until regX = - 1;
  152.                      BlockWrite(b, buffer, 8);
  153.                      secNo := secNo + 1
  154.                    end;
  155.               'B': err := true;
  156.               'C': begin
  157.                      regX := 0;
  158.                      newStart := true;
  159.                      repeat
  160.                        if newStart
  161.                            then begin
  162.                              read(a, start);
  163.                              count := count + 1;
  164. {
  165.                              writeln('Start=', start);
  166. }
  167.                              newStart := false
  168.                            end;
  169.                        if regX = start
  170.                            then begin
  171.                              read(a, limit, fill);
  172.                              count := count + 2;
  173. {
  174.                              write('Limit=', limit, '  Fill=')
  175.                              if (fill >= 32) and (fill <= 126)
  176.                                  then writeln('''', chr(fill), '''')
  177.                                else writeln(fill);
  178. }
  179.                              for i := regX to regX + limit - start - 1
  180.                                do buffer[i] := fill;
  181.                              regX := regX + limit - start;
  182.                              newStart := true
  183.                            end
  184.                          else begin
  185.                            read(a, data);
  186.                            count := count + 1;
  187.                            buffer[regX] := data
  188.                            regX := regX + 1
  189.                          end
  190.                      until regX = 128;
  191.                      BlockWrite(b, buffer, 8);
  192.                      secNo := secNo + 1
  193.                    end;
  194.               'D': begin
  195.                      read(a, start);
  196.                      count := count + 1;
  197.                      regX := start;
  198.                      repeat
  199.                        read(a, data);
  200.                        count := count + 1;
  201.                        buffer[regX] := data;
  202.                        regX := regX + 1
  203.                      until regX = 128;
  204.                      BlockWrite(b, buffer, 8);
  205.                      secNo := secNo + 1
  206.                    end;
  207.               'E': begin
  208.                      read(a, data, data);
  209.                      count := count + 2;
  210.                      if eof(a)
  211.                          then hasAddr := false
  212.                    end;
  213.               'F': begin
  214.                      BlockWrite(b, buffer, 8);
  215.                      secNo := secNo + 1
  216.                    end;
  217.               'G': begin
  218.                      for i := 0 to 127
  219.                        do begin
  220.                          read(a, buffer[i]);
  221.                          count := count + 1
  222.                        end;
  223.                      BlockWrite(b, buffer, 8);
  224.                      secNo := secNo + 1
  225.                    end
  226.             else err := true
  227.           end;
  228.           if hasAddr and not err
  229.               then begin
  230.                 read(a, lo, hi);
  231.                 count := count + 2;
  232.                 newSec := hi * 256 + lo;
  233.                 if (newSec <> 69) and (newSec < numSecs)
  234.                     then begin
  235. {
  236.                       writeln('Current sector = ', secNo, '  new sector = ', newSec);
  237. }
  238.                       if newSec > secNo
  239.                           then begin
  240.                             for i := secNo to newSec - 1
  241.                               do BlockWrite(b, pad, 8);
  242.                             secNo := newSec
  243.                           end
  244.                     end
  245.                   else {writeln(newSec, ' ignored!')}
  246.               end
  247.         until err or eof(a);
  248.         close(a)
  249.       end;
  250.     if err
  251.         then writeln('Sector = ', count div 512 + 1,
  252.                      ' Offset = ', count mod 512)
  253.       else if not done
  254.                then if multiExpected
  255.                         then begin
  256.                           inPathName[offs] := chr(ord(inPathName[offs]) + 1)
  257. {
  258. writeln('offset=',offs)
  259. writeln('''',inPathName,'''')
  260. }
  261.                         end
  262.                       else done := true
  263.   until done or err;
  264.   if not err
  265.       then if secNo < numSecs
  266.             then for i := secNo to numSecs
  267.                    do BlockWrite(b, pad, 8)
  268.   close(b)
  269. end.
  270.